CD Actual 22/PC Actual CD 22.iso/progs/DIRECTOR/data.z/Learning Director.dcr/UtilsCast_5_PS_ListScroller.ls

Text File | 1997-05-10 | 10.1 KB | 360 lines

property pTextLists, pClickCell, pClickHandler, pHasControls, pDrawingEnabled, pVScrollSpriteNum, pVThumbSpriteNum, pUpArrowSpriteNum, pDownArrowSpriteNum, pTotalVisLines, pCanScroll, pListTopV, pLineHeight, pTopLine, pHiliteFlag, pThumbTravel, pThumbTravelBottom, pThumbIncrement, pSelectedLine, pInitialized

on birth me, vScrollSpriteNum, vThumbSpriteNum, upArrowSpriteNum, downArrowSpriteNum, textLists, clickHandler
  return new(me, vScrollSpriteNum, vThumbSpriteNum, upArrowSpriteNum, downArrowSpriteNum, textLists, clickHandler)
end

on new me, vScrollSpriteNum, vThumbSpriteNum, upArrowSpriteNum, downArrowSpriteNum, textLists, clickHandler
  set pVScrollSpriteNum to vScrollSpriteNum
  set pVThumbSpriteNum to vThumbSpriteNum
  set pUpArrowSpriteNum to upArrowSpriteNum
  set pDownArrowSpriteNum to downArrowSpriteNum
  set pHasControls to pVScrollSpriteNum <> 0
  if not pHasControls then
    set pNoControls to 1
    set pVThumbSpriteNum to 0
    set pUpArrowSpriteNum to 0
    set pDownArrowSpriteNum to 0
  end if
  set pDrawingEnabled to 1
  set pHiliteFlag to 1
  set pTextLists to textLists
  if voidp(clickHandler) then
    set pClickHandler to EMPTY
  else
    set pClickHandler to clickHandler
  end if
  set pClickCell to point(0, 0)
  if pHasControls then
    puppetSprite(pVThumbSpriteNum, 1)
    puppetSprite(pUpArrowSpriteNum, 1)
    puppetSprite(pDownArrowSpriteNum, 1)
    set the locH of sprite pVThumbSpriteNum to the left of sprite pVScrollSpriteNum
  end if
  set firstTextSprite to getPropAt(pTextLists, 1)
  set pListTopV to the top of sprite firstTextSprite
  set pLineHeight to the textHeight of field the castNum of sprite firstTextSprite
  set pTotalVisLines to the height of sprite firstTextSprite / pLineHeight
  if pHasControls then
    set pThumbTravel to the top of sprite pDownArrowSpriteNum - the bottom of sprite pUpArrowSpriteNum - the height of sprite pVThumbSpriteNum
    set pThumbTravelBottom to the bottom of sprite pUpArrowSpriteNum + pThumbTravel
  else
    set pThumbTravel to 0
    set pThumbTravelBottom to 0
  end if
  set pSelectedLine to 0
  set pTopLine to 0
  set pInitialized to 0
  updateContents(me)
  return me
end

on ableDrawing me, able
  set pDrawingEnabled to able
  if not able then
    set pInitialized to 0
  end if
end

on showTextAt me, topLine
  if (topLine < 0) or not pInitialized then
    set forceRefresh to 1
    set topLine to abs(topLine)
  else
    set forceRefresh to 0
  end if
  set numLists to count(pTextLists)
  set listLines to count(getAt(pTextLists, 1))
  if topLine > listLines then
    set topLine to listLines
  else
    if topLine < 1 then
      set topLine to 1
    end if
  end if
  if not pDrawingEnabled then
    set pTopLine to topLine
    return
  end if
  set the updateLock to 1
  if (pTopLine <> topLine) or forceRefresh then
    set oldTopLine to pTopLine
    set pTopLine to topLine
    set botLine to topLine + pTotalVisLines - 1
    if botLine > listLines then
      set botLine to listLines
    end if
    set rebuildLinesNeeded to (oldTopLine <> topLine) or not pInitialized
    repeat with listIndex = 1 to numLists
      set charOffsetList to [1]
      set spriteNum to getPropAt(pTextLists, listIndex)
      set textCastNum to the castNum of sprite spriteNum
      set textList to getAt(pTextLists, listIndex)
      set newTextLines to EMPTY
      if listLines > 0 then
        if rebuildLinesNeeded or pHiliteFlag then
          repeat with lineNum = topLine to botLine
            put getAt(textList, lineNum) after newTextLines
            if lineNum < botLine then
              put RETURN after newTextLines
            end if
            append(charOffsetList, length(newTextLines) + 1)
          end repeat
        end if
        if rebuildLinesNeeded then
          set the text of field textCastNum to newTextLines
          startTimer()
          repeat while the timer < 20
            nothing()
          end repeat
        end if
        if pHiliteFlag then
          if (pSelectedLine >= topLine) and (pSelectedLine <= botLine) then
            set lineToSelect to pSelectedLine - topLine + 1
            hilite char getAt(charOffsetList, lineToSelect) to getAt(charOffsetList, lineToSelect + 1) - 1 of field textCastNum
          end if
        end if
        next repeat
      end if
      set the text of field textCastNum to newTextLines
    end repeat
  end if
  set pInitialized to 1
  if pHasControls then
    set thumbV to the bottom of sprite pUpArrowSpriteNum
    set thumbV to thumbV + (pThumbIncrement * (pTopLine - 1))
    set the locV of sprite pVThumbSpriteNum to thumbV
  end if
  set the updateLock to 0
  updateStage()
end

on scrollUp1 me
  showTextAt(me, pTopLine - 1)
end

on scrollDown1 me
  showTextAt(me, pTopLine + 1)
end

on updateContents me
  set listLines to count(getAt(pTextLists, 1))
  if (pTopLine = 0) or (pTopLine > listLines) then
    set pTopLine to 1
  end if
  if pHasControls then
    set pCanScroll to listLines > pTotalVisLines
    set the visible of sprite pVThumbSpriteNum to pCanScroll
    if listLines > 1 then
      set pThumbIncrement to float(pThumbTravel) / (listLines - 1)
    else
      set pThumbIncrement to 0
    end if
    set thumbV to the bottom of sprite pUpArrowSpriteNum
    set thumbV to thumbV + (pThumbIncrement * (pTopLine - 1))
    set the locV of sprite pVThumbSpriteNum to thumbV
  end if
  showTextAt(me, -pTopLine)
  if not pCanScroll then
    set col1Sprite to getPropAt(pTextLists, 1)
    set clipHeight to the height of sprite col1Sprite
    set textHeight to the height of member the castNum of sprite col1Sprite
    set pCanScroll to textHeight > clipHeight
    set the visible of sprite pVThumbSpriteNum to pCanScroll
  end if
end

on inUpArrow me
  if not pCanScroll then
    exit
  end if
  if pHasControls then
    puppetSprite(pUpArrowSpriteNum, 1)
    set aCastNum to the castNum of sprite pUpArrowSpriteNum
    set the castNum of sprite pUpArrowSpriteNum to aCastNum + 1
    updateStage()
  end if
  repeat while the mouseDown
    scrollUp1(me)
  end repeat
  if pHasControls then
    set the castNum of sprite pUpArrowSpriteNum to the number of member aCastNum
    updateStage()
    puppetSprite(pUpArrowSpriteNum, 0)
  end if
end

on inDownArrow me
  if not pCanScroll then
    exit
  end if
  if pHasControls then
    puppetSprite(pDownArrowSpriteNum, 1)
    set aCastNum to the castNum of sprite pDownArrowSpriteNum
    set the castNum of sprite pDownArrowSpriteNum to aCastNum + 1
    updateStage()
  end if
  repeat while the mouseDown
    scrollDown1(me)
  end repeat
  if pHasControls then
    set the castNum of sprite pDownArrowSpriteNum to the number of member aCastNum
    updateStage()
    puppetSprite(pDownArrowSpriteNum, 0)
  end if
end

on inThumb me
  if pHasControls then
    if not pCanScroll then
      exit
    end if
    repeat while the mouseDown
      set thumbV to constrainV(pVScrollSpriteNum, the mouseV)
      if thumbV > pThumbTravelBottom then
        set thumbV to pThumbTravelBottom
      end if
      set the locV of sprite pVThumbSpriteNum to thumbV
      updateStage()
    end repeat
    set newTopLine to ((thumbV - the top of sprite pVScrollSpriteNum) / pThumbIncrement) + 1
    set newTopLine to integer(newTopLine)
    showTextAt(me, newTopLine)
  end if
end

on inScrollBar me
  if pHasControls then
    if not pCanScroll then
      exit
    end if
    set clickPosV to the mouseV
    if clickPosV < the top of sprite pVThumbSpriteNum then
      showTextAt(me, pTopLine - pTotalVisLines)
    else
      if clickPosV > the bottom of sprite pVThumbSpriteNum then
        showTextAt(me, pTopLine + pTotalVisLines)
      end if
    end if
  end if
end

on inText me
  set clickPosV to the mouseV
  set visLineNum to the mouseLine - 1
  if visLineNum < 0 then
    return 0
  end if
  set selLineNum to visLineNum + pTopLine
  selectLine(me, selLineNum, 0)
  set N to count(pTextLists)
  repeat with col = 1 to N
    set spriteNum to getPropAt(pTextLists, col)
    if inside(point(the mouseH, the mouseV), the rect of sprite spriteNum) then
      exit repeat
    end if
  end repeat
  set pClickCell to point(selLineNum, col)
  if pClickHandler <> EMPTY then
    set s to pClickHandler & "( me, pClickCell )"
    do(s)
  end if
  return 1
end

on getClickCell me
  return the pClickCell of me
end

on selectLine me, selLineNum, scrollToLine
  if (selLineNum <> pSelectedLine) or scrollToLine then
    set listLines to count(getAt(pTextLists, 1))
    if selLineNum > listLines then
      set pSelectedLine to listLines
    else
      set pSelectedLine to max(selLineNum, 1)
    end if
    if the pCanScroll of me and scrollToLine then
      set topLine to pSelectedLine
    else
      set topLine to pTopLine
    end if
    showTextAt(me, -topLine)
  end if
end

on getSelectedCell me, columnNum
  if pSelectedLine > 0 then
    return getAt(getAt(pTextLists, columnNum), pSelectedLine)
  else
    return EMPTY
  end if
end

on setSelectedCell me, columnNum, text
  if pSelectedLine > 0 then
    set columnText to getAt(pTextLists, columnNum)
    setAt(columnText, pSelectedLine, text)
    set spriteNum to getPropAt(pTextLists, columnNum)
    set textCastNum to the castNum of sprite spriteNum
    set lineNum to pSelectedLine - pTopLine + 1
    put text into line lineNum of field textCastNum
    if pHiliteFlag then
      set the updateLock to 1
      put text into line lineNum of field textCastNum
      showTextAt(me, -pTopLine)
      set the updateLock to 0
    else
      put text into line lineNum of field textCastNum
    end if
  end if
end

on getSelectedLine me
  if pSelectedLine > 0 then
    return pSelectedLine
  else
    return 0
  end if
end

on getColumnText me, columnNum
  return getAt(pTextLists, columnNum)
end

on setColumnText me, columnNum, textList
  setAt(pTextLists, columnNum, textList)
  set pInitialized to 0
end

on dataChanged me
  set pTopLine to 0
  set pInitialized to 0
  updateContents(me)
  updateContents(me)
end

on getNumVisibleLines me
  return pTotalVisLines
end

on isLineVisible me, lineNum
  if (lineNum < pTopLine) or (lineNum > (pTopLine + pTotalVisLines - 1)) then
    return 0
  else
    return 1
  end if
end

on getTopLine me
  return pTopLine
end

on getTotalLines me
  return count(getAt(pTextLists, 1))
end

on setHiliteFlag me, state
  set pHiliteFlag to state
end